home *** CD-ROM | disk | FTP | other *** search
/ Win 50 Game+ Vol. 8 (Japan) / Win 50 Game+ Vol. 8 (Japan).bin / lha_file / cloop12a.lzh / CL12A_SC.LZH / CLMAIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-08  |  9.8 KB  |  387 lines
  1. unit Clmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Menus, ExtCtrls, about, inifiles, clsub,
  8.   Buttons;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     MainMenu1: TMainMenu;
  13.     Game1: TMenuItem;
  14.     New1: TMenuItem;
  15.     Restart1: TMenuItem;
  16.     N1: TMenuItem;
  17.     Bigpanel1: TMenuItem;
  18.     Exit1: TMenuItem;
  19.     Help1: TMenuItem;
  20.     Index1: TMenuItem;
  21.     About1: TMenuItem;
  22.     Image1: TImage;
  23.     Image2: TImage;
  24.     Panel1: TPanel;
  25.     lstep1: TLabel;
  26.     lcycle: TLabel;
  27.     lstep2: TLabel;
  28.     lscore: TLabel;
  29.     Property1: TMenuItem;
  30.     Options1: TMenuItem;
  31.     ldbl: TLabel;
  32.     Backbtn: TSpeedButton;
  33.     procedure About1Click(Sender: TObject);
  34.     procedure Exit1Click(Sender: TObject);
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure FormPaint(Sender: TObject);
  37.     procedure New1Click(Sender: TObject);
  38.     procedure Restart1Click(Sender: TObject);
  39.     procedure Bigpanel1Click(Sender: TObject);
  40.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  41.     procedure FormKeyPress(Sender: TObject; var Key: Char);
  42.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  43.       Shift: TShiftState; MX, MY: Integer);
  44.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; MX,
  45.       MY: Integer);
  46.     procedure Index1Click(Sender: TObject);
  47.     procedure Property1Click(Sender: TObject);
  48.     procedure BackbtnClick(Sender: TObject);
  49.   private
  50.     { Private ÉΘî╛ }
  51.     procedure newgame;
  52.     procedure writeini;
  53.     procedure turn;
  54.     procedure putpanel;
  55.     procedure stg0to1;
  56.     procedure move(xx, yy : integer);
  57.   public
  58.     { Public ÉΘî╛ }
  59.   end;
  60.  
  61. var
  62.   Form1: TForm1;
  63.  
  64. implementation
  65.  
  66. {$R *.DFM}
  67. const MAX = 20;
  68.  
  69. var path : string;
  70.     qstp, loop, size, level, step, nowstp, base, sc : integer;
  71.     org, num : array[1..MAX,1..MAX] of byte;
  72.     before, x, y, stage, psize : byte;
  73.     rect1,rect2 : Trect;
  74.     ans : array[1..2410,0..1] of byte;
  75.  
  76. procedure Tform1.writeini;
  77. var clini : TIniFile;
  78. begin
  79.     clini := TIniFile.Create(path + 'cybrloop.ini');
  80.     try
  81.         with clini do begin
  82.             writeinteger('OPTION','CYCLE',loop);
  83.             writeinteger('OPTION','SIZE',size);
  84.             writeinteger('OPTION','LOOP',step);
  85.             writebool('OPTION','BIGPANEL',bigpanel1.checked);
  86.             writeinteger('WINDOW','LEFT',form1.left);
  87.             writeinteger('WINDOW','TOP',form1.top);
  88.         end;
  89.     finally
  90.         clini.free;
  91.     end;
  92. end;
  93.  
  94. procedure rndset(var dx, dy : integer);
  95. begin
  96.     case random(4) of
  97.         0 : begin dx := -1; dy :=  0; end;
  98.         1 : begin dx :=  1; dy :=  0; end;
  99.         2 : begin dx :=  0; dy := -1; end;
  100.         3 : begin dx :=  0; dy :=  1; end;
  101.     end;
  102. end;
  103.  
  104. procedure Tform1.newgame;
  105. var sx, sy, i, j, dx, dy, dxx, dyy : integer;
  106.     f : boolean;
  107.     dat : system.text;
  108. begin
  109.     repeat
  110.         for i := 1 to size do for j := 1 to size do num[j,i] := 0;
  111.         sx := random(size)+1;
  112.         sy := random(size)+1;
  113.         x := sx;
  114.         y := sy;
  115.         rndset(dxx,dyy);
  116.         dx := dxx;
  117.         dy := dyy;
  118.         qstp := 0;
  119.         i := 0;
  120.         f := false;
  121.         repeat
  122.             case random(12) of
  123.                 0..1 : begin j := dx; dx := -dy; dy :=  j end;
  124.                 2..3 : begin j := dx; dx :=  dy; dy := -j end;
  125.             end;
  126.             while (x+dx < 1) or (x+dx > size) or (y+dy < 1) or (y+dy > size)
  127.                 or ((-dxx=dx) and (-dyy=dy)) do rndset(dx,dy);
  128.             num[x,y] := (num[x,y] + 1) mod loop;
  129.             if num[x,y] = 0 then inc(i);
  130.             x := x + dx;
  131.             y := y + dy;
  132.             dxx := dx;
  133.             dyy := dy;
  134.             inc(qstp);
  135.             ans[qstp,0] := x;
  136.             ans[qstp,1] := y;
  137.             f := (qstp > step * 1.2);
  138.         until f or ((qstp >= step) and (x = sx) and (y = sy));
  139.     until not f;
  140.     ldbl.caption := 'Dbl ' + inttostr(i);
  141.     assignfile(dat,path + 'cybrloop.ans');
  142.     rewrite(dat);
  143.     writeln(dat,'cycle : ',inttostr(loop-1),'  steps : ',inttostr(qstp),
  144.                 '  dbl : ',inttostr(i));
  145.     for i := 1 to size do begin
  146.         for j := 1 to size do write(dat,num[j,i]);
  147.         writeln(dat);
  148.     end;
  149.     for i := 1 to qstp do begin
  150.         write(dat,'(',ans[i,0]:2,',',ans[i,1]:2,')');
  151.         if i mod 10 = 0 then writeln(dat);
  152.     end;
  153.     closefile(dat);
  154.     org := num;
  155.     clientwidth := psize * size + 72;
  156.     clientheight := psize * size;
  157.     lcycle.caption := 'Cycle : ' + inttostr(loop-1);
  158.     lstep2.caption := inttostr(qstp) + 'step';
  159.     restart1click(New1);
  160. end;
  161.  
  162. procedure TForm1.New1Click(Sender: TObject);
  163. begin
  164.     newgame;
  165.     formpaint(sender);
  166. end;
  167.  
  168. procedure TForm1.Restart1Click(Sender: TObject);
  169. var i, j : byte;
  170. begin
  171.     num := org;
  172.     x := 1;
  173.     y := 1;
  174.     stage := 0;
  175.     nowstp := 0;
  176.     lstep1.caption := '0/';
  177.     lscore.caption := '0 pts';
  178.     base := 0;
  179.     for i := 1 to size do for j := 1 to size do inc(base,num[j,i]);
  180.     sc := base;
  181.     before := 0;
  182.     backbtn.enabled := false;
  183.     canvas.pen.color := clBlack;
  184.     canvas.brush.color := clBlack;
  185.     formpaint(sender);
  186. end;
  187.  
  188. procedure TForm1.Property1Click(Sender: TObject);
  189. begin
  190.     with form2 do begin
  191.         sploop.value := loop-1;
  192.         spsize.value := size;
  193.         spstep.value := step;
  194.         showmodal;
  195.         if modalresult = mrOk then begin
  196.             loop := sploop.value+1;
  197.             size := spsize.value;
  198.             step := spstep.value;
  199.             new1click(sender);
  200.         end;
  201.     end;
  202. end;
  203.  
  204. procedure TForm1.Bigpanel1Click(Sender: TObject);
  205. begin
  206.     bigpanel1.checked := not bigpanel1.checked;
  207.     if bigpanel1.checked then psize := 32 else psize := 22;
  208.     clientwidth := psize * size + 72;
  209.     clientheight := psize * size;
  210.     formpaint(sender);
  211. end;
  212.  
  213. procedure TForm1.Exit1Click(Sender: TObject);
  214. begin
  215.     writeini;
  216.     application.terminate;
  217. end;
  218.  
  219. procedure TForm1.Index1Click(Sender: TObject);
  220. begin
  221.     application.helpjump('HID_N0001');
  222. end;
  223.  
  224. procedure TForm1.About1Click(Sender: TObject);
  225. begin
  226.     aboutbox.comment.caption := 'Turn all the panels into stars.';
  227.     aboutbox.showmodal;
  228. end;
  229.  
  230. procedure TForm1.BackbtnClick(Sender: TObject);
  231. begin
  232.     dec(sc,num[x,y]);
  233.     num[x,y] := (num[x,y] + 1) mod loop;
  234.     inc(sc,num[x,y]);
  235.     putpanel;
  236.     x := x - ((before mod 16) - 1);
  237.     y := y - ((before div 16) - 1);
  238.     dec(nowstp);
  239.     lstep1.caption := inttostr(nowstp) + '/';
  240.     backbtn.enabled := false;
  241.     if nowstp = 0 then begin
  242.         stage := 0;
  243.         canvas.pen.color := clBlack;
  244.         canvas.brush.color := clBlack;
  245.     end;
  246.     canvas.rectangle((x-1)*psize,(y-1)*psize,x*psize,y*psize);
  247.     if nowstp <= qstp
  248.         then lscore.caption := inttostr(round((1-sc/base)*100)) + ' pts'
  249.         else lscore.caption := 'No pts';
  250. end;
  251.  
  252. procedure TForm1.FormCreate(Sender: TObject);
  253. var clini : TIniFile;
  254. begin
  255.     randomize;
  256.     path := extractfilepath(Application.ExeName);
  257.     clini := TIniFile.Create(path + 'cybrloop.ini');
  258.     try
  259.         loop := clini.readinteger('OPTION','CYCLE',3);
  260.         size := clini.readinteger('OPTION','SIZE',10);
  261.         step := clini.readinteger('OPTION','LOOP',40);
  262.         bigpanel1.checked := clini.readbool('OPTION','BIGPANEL',false);
  263.         left := clini.readinteger('WINDOW','LEFT',100);
  264.         top := clini.readinteger('WINDOW','TOP',100);
  265.     finally
  266.         clini.free;
  267.     end;
  268.     if bigpanel1.checked then psize := 32 else psize := 22;
  269.     canvas.brush.style := bsDiagCross;
  270.     newgame;
  271. end;
  272.  
  273. procedure Tform1.putpanel;
  274. begin
  275.     rect1 := rect((x-1)*psize,(y-1)*psize,x*psize,y*psize);
  276.     rect2 := rect(num[x,y]*psize,0,(num[x,y]+1)*psize,psize);
  277.     if bigpanel1.checked
  278.         then canvas.copyrect(rect1,image1.picture.bitmap.canvas,rect2)
  279.         else canvas.copyrect(rect1,image2.picture.bitmap.canvas,rect2);
  280. end;
  281.  
  282. procedure TForm1.FormPaint(Sender: TObject);
  283. var i, j : byte;
  284. begin
  285.     for i := 1 to size do for j := 1 to size do begin
  286.         rect1 := rect((j-1)*psize,(i-1)*psize,j*psize,i*psize);
  287.         rect2 := rect(num[j,i]*psize,0,(num[j,i]+1)*psize,psize);
  288.         if bigpanel1.checked
  289.             then canvas.copyrect(rect1,image1.picture.bitmap.canvas,rect2)
  290.             else canvas.copyrect(rect1,image2.picture.bitmap.canvas,rect2);
  291.     end;
  292.     canvas.rectangle((x-1)*psize,(y-1)*psize,x*psize,y*psize);
  293. end;
  294.  
  295. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  296. begin
  297.     writeini;
  298. end;
  299.  
  300. procedure Tform1.turn;
  301. begin
  302.     dec(sc,num[x,y]);
  303.     num[x,y] := (num[x,y] + loop - 1) mod loop;
  304.     inc(sc,num[x,y]);
  305.     putpanel;
  306.     canvas.rectangle((x-1)*psize,(y-1)*psize,x*psize,y*psize);
  307.     inc(nowstp);
  308.     lstep1.caption := inttostr(nowstp) + '/';
  309.     backbtn.enabled := true;
  310.     if nowstp <= qstp
  311.         then lscore.caption := inttostr(round((1-sc/base)*100)) + ' pts'
  312.         else lscore.caption := 'No pts';
  313.     if sc = 0 then begin
  314.         if nowstp <= qstp
  315.             then aboutbox.comment.caption := 'Congratulations !'
  316.             else aboutbox.comment.caption := 'Too many steps.Retry please.';
  317.         aboutbox.showmodal;
  318.         if nowstp <= qstp then new1click(new1) else restart1click(new1);
  319.     end;
  320. end;
  321.  
  322. procedure Tform1.move(xx, yy : integer);
  323. begin
  324.     if (x+xx >= 1) and (x+xx <= size) and
  325.        (y+yy >= 1) and (y+yy <= size) then begin
  326.             putpanel;
  327.             x := x + xx;
  328.             y := y + yy;
  329.             before := (xx+1) + (yy+1)*16;
  330.             if stage = 1 then turn
  331.             else canvas.rectangle((x-1)*psize,(y-1)*psize,x*psize,y*psize);
  332.     end;
  333. end;
  334.  
  335. procedure Tform1.stg0to1;
  336. begin
  337.     stage := 1;
  338.     canvas.pen.color := clRed;
  339.     canvas.brush.color := clRed;
  340.     turn;
  341. end;
  342.  
  343. procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
  344. begin
  345.     case upcase(key) of
  346.         '-' : if backbtn.enabled then backbtnclick(sender);
  347.         '2' : move(0,1);
  348.         '4' : move(-1,0);
  349.         '5' : if stage = 0 then stg0to1;
  350.         '6' : move(1,0);
  351.         '8' : move(0,-1);
  352.         'B' : bigpanel1click(sender);
  353.         'N' : new1click(sender);
  354.         'P' : property1click(sender);
  355.         'R' : restart1click(sender);
  356.     end;
  357. end;
  358.  
  359. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  360.   Shift: TShiftState; MX, MY: Integer);
  361. var lx, ly, xx, yy : integer;
  362. begin
  363.     lx := mx div psize + 1;
  364.     ly := my div psize + 1;
  365.     if (shift = [ssleft]) and (lx <= size) then case stage of
  366.         0 : stg0to1;
  367.         1 : begin
  368.                 xx := x - lx;
  369.                 yy := y - ly;
  370.                 if (xx * yy = 0) and (abs(xx+yy) = 1) then move(-xx,-yy);
  371.             end;
  372.     end;
  373. end;
  374.  
  375. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; MX,
  376.   MY: Integer);
  377. var lx, ly, xx, yy : integer;
  378. begin
  379.     if stage = 0 then begin
  380.         lx := mx div psize + 1;
  381.         ly := my div psize + 1;
  382.         if (lx <= size) and ((x <> lx) or (y <> ly)) then move(lx-x,ly-y);
  383.     end else if shift = [ssleft] then FormMouseDown(Sender,mbLeft,Shift,MX,MY);
  384. end;
  385.  
  386. end.
  387.